perm filename THRESH.SAI[PIC,HE] blob
sn#430347 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY THRESH,THRM,overlay
C00004 00003 SIMPLE SIMPLE PROCEDURE MNSNW ! MASK, NO SHRINK, NO WRAP-AROUND
C00007 00004 SIMPLE PROCEDURE NMNSNW ! NO MASK, NO SHRINK, NO WRAP-AROUND
C00009 00005 M←MASKBUF≥0 ! MASK?
C00011 00006 simple internal integer procedure thrm(integer curbuf,masKbuf,val,maskin,series)
C00017 ENDMK
C⊗;
ENTRY THRESH,THRM,overlay;
BEGIN "THRESH"
REQUIRE "BAYSAI.SAI" SOURCE!FILE;
SOURCE!L(UTILS.DCL);
SOURCE!V(PICBUF.DCL);
EXTERNAL INTEGER SIMPLE PROCEDURE CROP(INTEGER BUF,STARTI,ENDI,STARTJ,ENDJ);
INTEGER I,J,ILIM,JLIM,IPTR,OPTR,IINCR,JINCR,MPTR,
IMIN,JMIN,IMAX,JMAX;
INTERNAL INTEGER PROCEDURE THRESH(INTEGER CURBUF,MASKBUF,UPTHR,LWTHR,BYTZ,SHRINK);
BEGIN "TH"
SIMPLE PROCEDURE MM; BEGIN IF IMIN>0 THEN IMAX←I ELSE IMIN←IMAX←I;
IF JMIN>J THEN JMIN←J ELSE JMAX←JMAX MAX J; END;
INTEGER NEWBUF,NEWERBUF;
BOOLEAN M,S,W;
SIMPLE PROCEDURE IOPTR;
BEGIN
IPTR←INPTR(I+IINCR,JINCR+1,CURBUF);
OPTR←OUTPTR(I,1,NEWBUF);
END;
SIMPLE PROCEDURE IMOPTR;
BEGIN
IOPTR;
MPTR←INPTR(I,1,MASKBUF);
END;
SIMPLE SIMPLE PROCEDURE MNSNW; ! MASK, NO SHRINK, NO WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IMOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(MPTR) THEN IF LWTHR≤ILDB(IPTR)≤UPTHR THEN IDPB(-1,OPTR)
ELSE IBP(OPTR)
ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
END;
SIMPLE PROCEDURE MNSW; ! MASK, NO SHRINK, WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IMOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(MPTR) THEN
IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
THEN IDPB(-1,OPTR) ELSE IBP(OPTR)
ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
END;
SIMPLE PROCEDURE MSNW; ! MASK, SHRINK, NO WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IMOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(MPTR) THEN IF LWTHR≤ILDB(IPTR)≤UPTHR THEN
BEGIN
IDPB(-1,OPTR);
MM;
END
ELSE IBP(OPTR)
ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
END;
SIMPLE PROCEDURE MSW; ! MASK, SHRINK, WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IMOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(MPTR) THEN
IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
THEN BEGIN
IDPB(-1,OPTR);
MM;
END
ELSE IBP(OPTR)
ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
END;
SIMPLE PROCEDURE NMNSNW; ! NO MASK, NO SHRINK, NO WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF LWTHR≤ILDB(IPTR)≤UPTHR THEN IDPB(-1,OPTR)
ELSE IBP(OPTR);
END;
SIMPLE PROCEDURE NMNSW; ! NO MASK, NO SHRINK, WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
THEN IDPB(-1,OPTR) ELSE IBP(OPTR);
END;
SIMPLE PROCEDURE NMSNW; ! NO MASK, SHRINK, NO WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF LWTHR≤ILDB(IPTR)≤UPTHR THEN
BEGIN
IDPB(-1,OPTR);
MM;
END
ELSE IBP(OPTR);
END;
SIMPLE PROCEDURE NMSW; ! NO MASK, SHRINK, WRAP-AROUND;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IOPTR;
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
THEN BEGIN
IDPB(-1,OPTR);
MM;
END
ELSE IBP(OPTR);
END;
M←MASKBUF≥0; ! MASK? ;
S←SHRINK≠0; ! SHRINK? ;
W←LWTHR>UPTHR; ! WRAP-AROUND? ;
IF M THEN
BEGIN
ILIM←ROWS(MASKBUF);
JLIM←COLMS(MASKBUF);
IINCR←ISUBST(MASKBUF)-ISUBST(CURBUF);
JINCR←JSUBST(MASKBUF)-JSUBST(CURBUF);
GETBUF(ILIM,JLIM,BYTZ,NEWBUF←FNDBUF);
PUTSUB(ISUBST(MASKBUF),JSUBST(MASKBUF),NEWBUF);
END
ELSE
BEGIN
ILIM←ROWS(CURBUF);
JLIM←COLMS(CURBUF);
GETBUF(ILIM,JLIM,BYTZ,NEWBUF←FNDBUF);
PUTSUB(ISUBST(CURBUF),JSUBST(CURBUF),NEWBUF);
IINCR←JINCR←0;
END;
IF S THEN
BEGIN
JMIN←10240;
IMIN←IMAX←JMAX←-1;
IF M THEN IF W THEN MSW ELSE MSNW
ELSE IF W THEN NMSW ELSE NMSNW
END
ELSE
IF M THEN IF W THEN MNSW ELSE MNSNW
ELSE IF W THEN NMNSW ELSE NMNSNW;
IF S THEN
BEGIN
SHRINK←SHRINK MAX 0;
IMIN←(IMIN-SHRINK) MAX 1;
JMIN←(JMIN-SHRINK) MAX 1;
IMAX←(IMAX+SHRINK) MIN ILIM;
JMAX←(JMAX+SHRINK) MIN JLIM;
NEWBUF←CROP(NEWERBUF←NEWBUF,IMIN,IMAX,JMIN,JMAX);
FREBUF(NEWERBUF);
END;
RETURN(NEWBUF);
END "TH";
simple internal integer procedure thrm(integer curbuf,masKbuf,val,maskin,series);
BEGIN "RM"
INTEGER K,TEMP,SPBUF,BUF,s1,i1,j1;
INTEGER ISUBMB,ISUBCB,JSUBMB,JSUBCB;
STRING TSTR,STR,FILNAM,FILE,FILEXT,OUTEXT,NOTE,TNOTE,INDIC,OUTNAM;
ilim←(((ISUBMB←isubst(maskbuf))+rows(maskbuf)) min ((ISUBCB←isubst(curbuf))+rows(curbuf)))-(ISUBMB max ISUBCB);
jlim←(((JSUBMB←jsubst(maskbuf))+colms(maskbuf)) min ((JSUBCB←jsubst(curbuf))+colms(curbuf)))-(JSUBMB max JSUBCB);
IF series THEN
BEGIN "SERIES"
IFC FALSE THENC COMMENT SERIES REMOVED BECAUSE ITS NO LONGER USED;
sprmpt("FILE NAME",file);
sprmpt("FILE EXT",FILEXT);
sprmpt("FILE INDICATORS",indic←"RGBDHSYIQ");
sprmpt("OUTPUT FILE NAME",OUTNAM);
sprmpt("OUTPUT FILE EXT",OUTEXT);
VAL←-1;
WHILE TRUE DO
BEGIN "SERLP"
TSTR←LOP(INDIC);
IF NOT TSTR THEN DONE;
IF TSTR="D" THEN TSTR←NULL;
FILNAM←FILE&TSTR&"."&FILEXT;
INDMP("DSK",FILNAM,BUF←FNDBUF,0);
IINCR←ISUBMB-ISUBST(BUF);
JINCR←JSUBMB-JSUBST(BUF)+1;
GETBUF(ILIM,JLIM,BYTSZ(BUF),SPBUF←FNDBUF);
PUTSUB(ISUBMB,JSUBMB,SPBUF);
FOR I←1 THRU ILIM DO
BEGIN
IPTR←INPTR(I+IINCR,JINCR,BUF);
MPTR←INPTR(I,1,MASKBUF);
OPTR←OUTPTR(I,1,SPBUF);
FOR J←1 THRU JLIM DO
IF ILDB(MPTR) THEN IDPB(ILDB(IPTR),OPTR)
ELSE BEGIN IBP(IPTR); IDPB(VAL,OPTR); END;
ROWCHK(CHKROW,ROWS,I,50);
END;
FREBUF(BUF);
OUTDMP("DSK",OUTNAM&TSTR&"."&OUTEXT,SPBUF,0);
FREBUF(SPBUF);
PRINT("JUST PROCESSED FILE: ",FILNAM,CRLF);
END "SERLP";
FREBUF(MASKBUF);
ELSEC PRINT("NO SERIES",CRLF);
ENDC
END "SERIES"
ELSE begin "NO SERIES"
IINCR←(IF ISUBMB>ISUBCB THEN ISUBMB-ISUBCB ELSE 0)+1;
JINCR←(IF JSUBMB>JSUBCB THEN JSUBMB-JSUBCB ELSE 0)+1;
I1←(IF ISUBCB>ISUBMB THEN ISUBCB-ISUBMB ELSE 0)+1;
J1←(IF JSUBCB>JSUBMB THEN JSUBCB-JSUBMB ELSE 0)+1;
IF maskin THEN
BEGIN "MASK IN"
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IPTR←INPTR(I+i1-1,j1,MASKBUF);
OPTR←OUTPTR(I+IINCR-1,JINCR,CURBUF);
FOR J←1 STEP 1 UNTIL JLIM DO
IF ILDB(IPTR) THEN IDPB(VAL,OPTR)
ELSE IBP(OPTR);
ROWCHK(CHKROW,ROWS,I,50);
END;
END "MASK IN"
ELSE BEGIN "MASK OUT"
GETBUF((ILIM max 4),(JLIM max 4),BYTSZ(CURBUF),SPBUF←FNDBUF);
PUTSUB((ISUBMB MAX ISUBCB),(JSUBMB MAX JSUBCB),SPBUF);
FOR I←1 THRU ILIM DO
BEGIN
IPTR←INPTR(I+IINCR-1,JINCR,CURBUF);
MPTR←INPTR(I+i1-1,j1,MASKBUF);
OPTR←OUTPTR(I,1,SPBUF);
FOR J←1 THRU JLIM DO
IF ILDB(MPTR) THEN IDPB(ILDB(IPTR),OPTR)
ELSE BEGIN IBP(IPTR); IDPB(VAL,OPTR); END;
ROWCHK(CHKROW,ROWS,I,50);
END;
FREBUF(CURBUF);
CURBUF←SPBUF;
END "MASK OUT";
END "NO SERIES";
return(curbuf);
END "RM";
SIMPLE internal PROCEDURE OVERLAY(INTEGER CURBUF,MASKBUF);
BEGIN "OVERLAY"
INTEGER ILIM,JLIM,IPTR,OPTR,IINCR,JINCR,VAL;
ILIM←ROWS(MASKBUF);
JLIM←COLMS(MASKBUF);
IINCR←ISUBST(MASKBUF)-ISUBST(CURBUF);
JINCR←JSUBST(MASKBUF)-JSUBST(CURBUF)+1;
FOR I←1 STEP 1 UNTIL ILIM DO
BEGIN
IPTR←INPTR(I,1,MASKBUF);
OPTR←OUTPTR(I+IINCR,JINCR,CURBUF);
FOR J←1 STEP 1 UNTIL JLIM DO
IF VAL←ILDB(IPTR) THEN IDPB(VAL,OPTR)
ELSE IBP(OPTR);
ROWCHK(CHKROW,ROWS,I,100);
END;
END "OVERLAY";
END "THRESH";